# install.packages("psych", repos = "http://personality-project.org/r", type = "source")
# install.packages("psychTools", repos = "http://personality-project.org/r", type = "source")
# install.packages("skimr")
# Load the relevant libraries --------------------------
library(psych)
library(psychTools)
library(tidyverse)
library(janitor)
library(readxl)
library(ggpubr)
library(kableExtra)
# Make sure you're running the most recent version of psych
# sessionInfo()# Load the functions and data --------------------------
`%nin%` <- Negate(`%in%`)
## Load in the score data
dryRun_ScoreExportNarrow <- read_csv("/Volumes/fsmresfiles/MSS/Research/Projects/Baby_Toolbox/Data/Combined_Dry_Run_Data/dryRun_ScoreExportNarrow_20230323.csv") %>%
janitor::clean_names()
# dim(dryRun_ScoreExportNarrow)
# colnames(dryRun_ScoreExportNarrow)
## Load in the age data
dryRun_Registration_Age <- read_csv("/Volumes/fsmresfiles/MSS/Research/Projects/Baby_Toolbox/Data/Combined_Dry_Run_Data/dryRun_Registration_Age_20230323.csv") %>%
janitor::clean_names()
# dim(dryRun_Registration_Age)
# colnames(dryRun_Registration_Age)
# These are the IDs we care about for analysis
ids_for_analysis <- read_csv("data/2023-03-22T172307_shouldHavecorrected2.csv") %>%
rename(PIN = PINsago)
# dim(ids_for_analysis)
analysis_ids <- ids_for_analysis %>%
pull(PIN)# EF Cog -----
# See if anything exploded for EF Cog 16 to 24 months (Touch & Gaze)
ef_names <- c("ExecutiveFunction", "TouchTutorial", #"MVR",
"MemTaskLearn", "VDRTouch", "MemTaskTest")
ef_cog_df <- dryRun_ScoreExportNarrow %>%
filter(test_name %in% ef_names) %>%
filter(pin %in% analysis_ids)
# ef_cog_df %>%
# count(test_name, instrument_title)
#
# ef_cog_df %>%
# count(instrument_title, key)
#
# ef_cog_df %>%
# count(test_name, key)
ef_cog_age_df <- full_join(ef_cog_df, dryRun_Registration_Age,
by = c("pin", "pid", "registration_id", "assessment_name"),
multiple = "all")ef_cog_pivot <- ef_cog_age_df %>%
filter(!is.na(instrument_title)) %>%
filter(key %nin% c("Language", "InstrumentSandSReason",
"InstrumentRCReasonOther", "InstrumentBreakoff",
"InstrumentStatus2")) %>%
pivot_wider(id_cols = c(pin, pid, registration_id,
assessment_name, #instrument_title,
total_age_in_months),
names_from = c("test_name", "key"),
values_from = "value") %>%
select(pin:total_age_in_months, starts_with("TouchTutorial_"),
starts_with("MemTaskLearn_"), starts_with("MemTaskTest_"),
starts_with("VDRTouch_"), starts_with("ExecutiveFunction_"),
everything()) %>%
type_convert()ef_cog_age_df %>%
filter(!is.na(test_name)) %>%
select(pin, test_name, total_age_in_months) %>%
unique() %>%
group_by(test_name) %>%
mutate(min_age = min(total_age_in_months),
max_age = max(total_age_in_months)) %>%
ungroup() %>%
count(test_name, min_age, max_age) %>%
rename("Test Name" = test_name,
"Min Age" = min_age,
"Max Age" = max_age)%>%
kbl(caption = "Number of participants and age range by task") %>%
kable_styling()| Test Name | Min Age | Max Age | n |
|---|---|---|---|
| ExecutiveFunction | 6 | 21 | 35 |
| MemTaskLearn | 16 | 48 | 42 |
| MemTaskTest | 16 | 48 | 42 |
| TouchTutorial | 16 | 48 | 42 |
| VDRTouch | 16 | 48 | 42 |
ef_cog_age_df %>%
filter(total_age_in_months < 25) %>%
filter(!is.na(test_name)) %>%
select(pin, test_name, total_age_in_months) %>%
unique() %>%
count(test_name) %>%
rename("Test Name" = test_name) %>%
kbl(caption = "Number of participants by task (<25 months)") %>%
kable_styling()| Test Name | n |
|---|---|
| ExecutiveFunction | 35 |
| MemTaskLearn | 8 |
| MemTaskTest | 8 |
| TouchTutorial | 8 |
| VDRTouch | 8 |
ef_cog_age_df %>%
filter(total_age_in_months < 25) %>%
filter(key == "InstrumentBreakoff") %>%
count(test_name, value) %>%
filter(value == 1) %>%
select(-c(value)) %>%
rename("Test Name" = test_name) %>%
kbl(caption = "Whose instrument’s administration was interrupted? (<25 months)") %>%
kable_styling()| Test Name | n |
|---|---|
| ExecutiveFunction | 7 |
| MemTaskLearn | 7 |
| MemTaskTest | 8 |
| TouchTutorial | 4 |
| VDRTouch | 6 |
ef_cog_age_df %>%
filter(total_age_in_months < 25) %>%
filter(key == "InstrumentStatus2") %>%
count(test_name, value) %>%
filter(value == 4) %>%
select(-c(value)) %>%
rename("Test Name" = test_name) %>%
kbl(caption = "Who did not complete the assessment? (<25 months)") %>%
kable_styling()| Test Name | n |
|---|---|
| ExecutiveFunction | 7 |
| MemTaskLearn | 7 |
| MemTaskTest | 8 |
| TouchTutorial | 4 |
| VDRTouch | 6 |
ef_cog_age_df %>%
filter(total_age_in_months < 25) %>%
filter(key == "InstrumentRCReasonOther") %>%
count(test_name, value) %>%
filter(test_name != "ExecutiveFunction") %>%
rename("Test Name" = test_name) %>%
kbl(caption = "Reason for interuption on touch tasks (<25 months)") %>%
kable_styling()| Test Name | value | n |
|---|---|---|
| MemTaskLearn | Delay ended test | 2 |
| MemTaskLearn | Participant accidently used admin gesture, test will not resume. | 1 |
| MemTaskLearn | Participant used admin waver | 1 |
| MemTaskTest | Memory Task Test started before minimum time | 1 |
| MemTaskTest | Memory Task Test started before minimum time | Delay ended test | 1 |
| MemTaskTest | Memory Task Test started before minimum time | Delayed | Repeated Memory Task Test | 2 |
| MemTaskTest | Skipped test | 4 |
| TouchTutorial | App interruption | Nbt touch tutorial not functioning? | 1 |
| VDRTouch | App interruption | I am trying to keep her engaged but she is having a massive tantrum | 1 |
| VDRTouch | Delayed | Delayed | 1 |
ef_cog_pivot %>%
select(total_age_in_months, starts_with("TouchTutorial_"), starts_with("MemTaskLearn_"), starts_with("MemTaskTest_"),
starts_with("VDRTouch_")) %>%
select(-c(ends_with("_ItemCount"))) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
cor.plot(., xlas = 3)ef_cog_pivot %>%
select(total_age_in_months, starts_with("TouchTutorial_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
kbl(caption = "Correlations of Age and Touch Tutorial") %>%
kable_styling()| total_age_in_months | TouchTutorial_ItemCount | TouchTutorial_RawScore | |
|---|---|---|---|
| total_age_in_months | 1.000 | 0.068 | 0.308 |
| TouchTutorial_ItemCount | 0.068 | 1.000 | -0.646 |
| TouchTutorial_RawScore | 0.308 | -0.646 | 1.000 |
ef_cog_pivot %>%
select(total_age_in_months, starts_with("MemTaskLearn_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
kbl(caption = "Correlations of Age and Memorty Task (Learning)") %>%
kable_styling()| total_age_in_months | MemTaskLearn_ItemCount | MemTaskLearn_RawScore | |
|---|---|---|---|
| total_age_in_months | 1.000 | 0.564 | 0.422 |
| MemTaskLearn_ItemCount | 0.564 | 1.000 | NA |
| MemTaskLearn_RawScore | 0.422 | NA | 1.000 |
ef_cog_pivot %>%
select(total_age_in_months, starts_with("MemTaskTest_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
kbl(caption = "Correlations of Age and Memorty Task (Test)") %>%
kable_styling()| total_age_in_months | MemTaskTest_ItemCount | MemTaskTest_RawScore | |
|---|---|---|---|
| total_age_in_months | 1.000 | 0.41 | -0.048 |
| MemTaskTest_ItemCount | 0.410 | 1.00 | NA |
| MemTaskTest_RawScore | -0.048 | NA | 1.000 |
ef_cog_pivot %>%
select(total_age_in_months,
starts_with("VDRTouch_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
kbl(caption = "Correlations of Age and VDR") %>%
kable_styling()| total_age_in_months | VDRTouch_VDRTouchAccuracy | VDRTouch_VDRTouchReactionCorrect | VDRTouch_VDRTouchReactionIncorrect | VDRTouch_ItemCount | |
|---|---|---|---|---|---|
| total_age_in_months | 1.000 | 0.341 | -0.178 | -0.053 | 0.561 |
| VDRTouch_VDRTouchAccuracy | 0.341 | 1.000 | -0.284 | -0.252 | NA |
| VDRTouch_VDRTouchReactionCorrect | -0.178 | -0.284 | 1.000 | 0.385 | NA |
| VDRTouch_VDRTouchReactionIncorrect | -0.053 | -0.252 | 0.385 | 1.000 | NA |
| VDRTouch_ItemCount | 0.561 | NA | NA | NA | 1.000 |
ef_cog_pivot %>%
select(total_age_in_months, starts_with("ExecutiveFunction_")) %>%
select(-c(ends_with("_ItemCount"))) %>%
rename_with(stringr::str_replace,
pattern = "ExecutiveFunction\\_", replacement = "",
matches("ExecutiveFunction\\_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
cor.plot(., xlas = 3)ef_cog_pivot %>%
select(total_age_in_months, starts_with("ExecutiveFunction_")) %>%
rename_with(stringr::str_replace,
pattern = "ExecutiveFunction\\_", replacement = "",
matches("ExecutiveFunction\\_")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
kbl(caption = "Correlations of Age and Gaze") %>%
kable_styling()| total_age_in_months | RawScore | FamiliarizationRound1 | FamiliarizationRound2 | FamiliarizationMean | AverageNovelty1Scores | AverageNovelty2Scores | AverageNoveltyDelayedRecall | AverageNoveltyImmediatePreference | VDRCorrectRound1 | VDRCorrectRound2 | VDRCorrectBothRounds | ItemCount | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| total_age_in_months | 1.000 | 0.176 | 0.095 | -0.184 | -0.027 | 0.157 | 0.208 | 0.338 | 0.262 | -0.328 | -0.420 | -0.551 | -0.117 |
| RawScore | 0.176 | 1.000 | -0.190 | -0.117 | -0.185 | 0.425 | 0.629 | 0.580 | 0.680 | -0.544 | -0.494 | -0.498 | -0.281 |
| FamiliarizationRound1 | 0.095 | -0.190 | 1.000 | 0.070 | 0.548 | -0.176 | -0.183 | -0.272 | -0.178 | 0.081 | 0.352 | 0.291 | 0.094 |
| FamiliarizationRound2 | -0.184 | -0.117 | 0.070 | 1.000 | 0.868 | 0.198 | -0.653 | -0.412 | -0.393 | 0.200 | 0.405 | 0.259 | -0.136 |
| FamiliarizationMean | -0.027 | -0.185 | 0.548 | 0.868 | 1.000 | 0.113 | -0.529 | -0.435 | -0.322 | 0.232 | 0.476 | 0.354 | 0.053 |
| AverageNovelty1Scores | 0.157 | 0.425 | -0.176 | 0.198 | 0.113 | 1.000 | 0.364 | 0.401 | 0.751 | -0.298 | -0.198 | -0.208 | -0.206 |
| AverageNovelty2Scores | 0.208 | 0.629 | -0.183 | -0.653 | -0.529 | 0.364 | 1.000 | 0.576 | 0.858 | -0.440 | -0.485 | -0.438 | -0.216 |
| AverageNoveltyDelayedRecall | 0.338 | 0.580 | -0.272 | -0.412 | -0.435 | 0.401 | 0.576 | 1.000 | 0.612 | -0.354 | -0.736 | -0.556 | -0.372 |
| AverageNoveltyImmediatePreference | 0.262 | 0.680 | -0.178 | -0.393 | -0.322 | 0.751 | 0.858 | 0.612 | 1.000 | -0.543 | -0.438 | -0.469 | -0.283 |
| VDRCorrectRound1 | -0.328 | -0.544 | 0.081 | 0.200 | 0.232 | -0.298 | -0.440 | -0.354 | -0.543 | 1.000 | 0.574 | 0.854 | 0.215 |
| VDRCorrectRound2 | -0.420 | -0.494 | 0.352 | 0.405 | 0.476 | -0.198 | -0.485 | -0.736 | -0.438 | 0.574 | 1.000 | 0.836 | 0.124 |
| VDRCorrectBothRounds | -0.551 | -0.498 | 0.291 | 0.259 | 0.354 | -0.208 | -0.438 | -0.556 | -0.469 | 0.854 | 0.836 | 1.000 | 0.231 |
| ItemCount | -0.117 | -0.281 | 0.094 | -0.136 | 0.053 | -0.206 | -0.216 | -0.372 | -0.283 | 0.215 | 0.124 | 0.231 | 1.000 |
lapply(
names(ef_cog_pivot)[c(7, 9, 11:14)],
function(n)
ggplot(data = ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
lapply(
names(ef_cog_pivot)[16:26],
function(n)
ggplot(data = ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
lapply(
names(ef_cog_pivot)[c(7, 9, 11:14)],
function(n)
ggplot(data = ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) +
geom_point() +
geom_smooth(se = FALSE, color = "red") +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
lapply(
names(ef_cog_pivot)[16:26],
function(n)
ggplot(data = ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) +
geom_point() +
geom_smooth(se = FALSE, color = "red") +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
Old Memory Graph
Old VDR Graph
limitedAge_ef_cog_pivot <- ef_cog_pivot %>%
filter(between(total_age_in_months, 16, 21))lapply(
names(limitedAge_ef_cog_pivot)[c(7, 9, 11:14)],
function(n)
ggplot(data = limitedAge_ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
lapply(
names(limitedAge_ef_cog_pivot)[16:26],
function(n)
ggplot(data = limitedAge_ef_cog_pivot, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
lapply(
names(limitedAge_ef_cog_pivot)[c(7, 9, 11:14)],
function(n)
ggplot(data = limitedAge_ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) +
geom_point() +
geom_smooth(se = FALSE, color = "red") +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
lapply(
names(limitedAge_ef_cog_pivot)[16:26],
function(n)
ggplot(data = limitedAge_ef_cog_pivot, aes_string(x = "total_age_in_months", y = n)) +
geom_point() +
geom_smooth(se = FALSE, color = "red") +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
ef_cog_pivot_2 <- ef_cog_pivot %>%
filter(ExecutiveFunction_FamiliarizationRound2 < 6000)
limitedAge_ef_cog_pivot2 <- limitedAge_ef_cog_pivot %>%
filter(ExecutiveFunction_FamiliarizationRound2 < 6000)ef_cog_pivot_2 %>%
select(total_age_in_months, starts_with("ExecutiveFunction_")) %>%
rename_with(stringr::str_replace,
pattern = "ExecutiveFunction\\_", replacement = "",
matches("ExecutiveFunction\\_")) %>%
select(total_age_in_months, starts_with("Familiarization")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
cor.plot(., xlas = 3)lapply(
names(ef_cog_pivot_2)[17:19],
function(n)
ggplot(data = ef_cog_pivot_2, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
lapply(
names(ef_cog_pivot_2)[17:19],
function(n)
ggplot(data = ef_cog_pivot_2, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(color = "red", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw() +
scale_x_continuous(breaks = seq(2, 50, 2), labels = seq(2, 50, 2))
)## [[1]]
##
## [[2]]
##
## [[3]]
limitedAge_ef_cog_pivot2 %>%
select(total_age_in_months, starts_with("ExecutiveFunction_")) %>%
rename_with(stringr::str_replace,
pattern = "ExecutiveFunction\\_", replacement = "",
matches("ExecutiveFunction\\_")) %>%
select(total_age_in_months, starts_with("Familiarization")) %>%
cor(., use = "pairwise", method = "spearman") %>%
round(., 3) %>%
cor.plot(., xlas = 3)lapply(
names(limitedAge_ef_cog_pivot2)[17:19],
function(n)
ggplot(data = limitedAge_ef_cog_pivot2, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]
lapply(
names(limitedAge_ef_cog_pivot2)[17:19],
function(n)
ggplot(data = limitedAge_ef_cog_pivot2, aes_string(x="total_age_in_months", y = n)) +
geom_point() +
geom_smooth(color = "red", se = FALSE) +
stat_cor(method = "spearman",
aes(label = ..r.label..)) +
theme_bw()
)## [[1]]
##
## [[2]]
##
## [[3]]